home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / ssavwin.exe / TUBESAVR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-29  |  5.2 KB  |  118 lines
  1. {****************************************************************************
  2. *                                                                           *
  3. *  TubeSavr.pas: Plug-in animation module for SSaveDem.pas                  *
  4. *                                                                           *
  5. *  Rev. 0.1   19.4.93   MK  IR                                              *
  6. *                                                                           *
  7. ****************************************************************************}
  8.  
  9. { Name for this Screen Saver - shows up in Control Panel: }
  10. {$D SCRNSAVE Tubes }
  11.  
  12. const AppName: PChar = 'Screen Saver.Tubes' ;
  13.  
  14. type
  15.   PMySaverWin = ^TMySaverWin;
  16.   TMySaverWin = Object(TScSaverWin)
  17.     zx, zy, cx, cy, vx, vy, d: integer;
  18.     NewBrush: hBrush;
  19.     constructor Init (aParent:PWindowsObject; aTitle:PChar);
  20.     procedure DoTheShow; virtual;
  21.     destructor Done; virtual;
  22.   end;
  23.  
  24.  
  25. {****************************************************************************
  26. *                                                                           *
  27. *                       T M y S a v e r W i n . I n i t                     *
  28. *                                                                           *
  29. *  OUTPUT: zx, zy = screen dimensions                                       *
  30. *          vx, vy = speed of circle                                         *
  31. *          cx, cy = starting position                                       *
  32. *          d      = circle diameter  (all of the above in pixels)           *
  33. *          NewBrush = brush with random solid color                         *
  34. *                                                                           *
  35. ****************************************************************************}
  36.  
  37. constructor TMySaverWin.Init;
  38.  
  39. var color: TColorRef;
  40.     TheDC: hDC;
  41.  
  42. begin
  43. inherited Init (aParent, aTitle);
  44. randomize;
  45. zx := GetSystemMetrics (SM_CXSCREEN) ;
  46. zy := GetSystemMetrics (SM_CYSCREEN) ;                { get screen dimensions }
  47. cx := random (zx div 2) + 1;
  48. cy := random (zy div 2) + 1;                          { get starting position }
  49. vx := 2*(random (2)+1);
  50. vy := 2*(random (2)+1);                               { get speed }
  51. d  := zy div 8;                                       { diameter }
  52.  
  53. TheDC := TestHandle (GetDC (hWindow));
  54. color := GetNearestColor (TheDC, rgb (random(256), random(256), random(256)));
  55. if (color = 0) then color := $FFFFFF;        { black on black would be boring }
  56. NewBrush := TestHandle (CreateSolidBrush (color));
  57. ReleaseDC (hWindow, TheDC);
  58.  
  59. end;  { Init }
  60.  
  61. {****************************************************************************
  62. *                                                                           *
  63. *                  T M y S a v e r W i n . D o T h e S h o w                *
  64. *                                                                           *
  65. *  INPUT:  zx, zy = screen dimensions                                       *
  66. *          vx, vy = actual speed                                            *
  67. *          cx, cy = actual position                                         *
  68. *          d      = circle diameter  (all of the above in pixels)           *
  69. *          NewBrush = brush with color to use                               *
  70. *                                                                           *
  71. *  OUTPUT: vx, vy = new speed of circle                                     *
  72. *          cx, cy = new position                                            *
  73. *          NewBrush = brush, maybe with new random solid color              *
  74. *                                                                           *
  75. ****************************************************************************}
  76.  
  77. procedure TMySaverWin.DoTheShow ;
  78.  
  79. var TheDC: hDC;
  80.     OldBrush: hBrush;
  81.     color: TColorRef;
  82.  
  83. begin
  84. TheDC := TestHandle (GetDC (hWindow));
  85. if ((cx <= 0) or (cx+d >= zx)) then vx := -vx;      { bounce circle at edges }
  86. if ((cy <= 0) or (cy+d >= zy)) then vy := -vy;
  87. cx := cx+vx;                                        { calculate new position }
  88. cy := cy+vy;
  89.  
  90. if ((abs (zx div 2 - cx) < zx div 32)
  91.        and (abs (zy div 2 - cy) < zy div 32)) then   { if at center of screen,}
  92.    begin                                             { change color: }
  93.    DeleteObject (NewBrush);
  94.    color :=rgb (random(256), random(256), random(256));
  95.    NewBrush := TestHandle (CreateSolidBrush (GetNearestColor (TheDC, color)));
  96.    end;
  97. OldBrush := TestHandle (SelectObject (TheDC, NewBrush));
  98. Ellipse (TheDC, cx, cy, cx+d, cy+d);                { paint circle }
  99. TestHandle (SelectObject (TheDC, OldBrush));
  100.  
  101. ReleaseDC (hWindow, TheDC);
  102. end;  { DoTheShow }
  103.  
  104. {****************************************************************************
  105. *                                                                           *
  106. *                  T M y S a v e r W i n . D o n e                          *
  107. *                                                                           *
  108. ****************************************************************************}
  109.  
  110. destructor TMySaverWin.Done;   { cleans up }
  111. begin
  112. DeleteObject (NewBrush);
  113. inherited done;
  114. end;
  115.  
  116.  
  117.  
  118.